home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / door / twview93.zip / TOUR.INC < prev    next >
Text File  |  1992-05-07  |  13KB  |  449 lines
  1. type
  2.   SectorVisitStatus = (unreachable, visited, scanned, open);
  3.   ScannerMap = array [1..MaxSector] of SectorVisitStatus;
  4.   route = record
  5.             length : sectorIndex;               { actual trip length   }
  6.             more   : integer;                   { how many more to hit }
  7.             path   : array [ 1..2000 ] of sector;
  8.           end;
  9.  
  10.   nodeptr = ^node;
  11.   node    = record next : nodeptr; s : sector; end;
  12.   squeue  = record front, rear : nodeptr; end;
  13.  
  14. procedure ensqueue( e : sector; var q : squeue );
  15. var
  16.   NewGuy : nodeptr;
  17. begin
  18.   New( NewGuy );
  19.   if NewGuy = nil then
  20.     begin
  21.       writeln('error: out of memory during ensqueue');
  22.       readln;
  23.       halt;
  24.     end;
  25.   with NewGuy^ do
  26.     begin
  27.       s := e;
  28.       next := nil;
  29.     end; {with}
  30.   if q.rear = nil then
  31.     q.front := newguy
  32.   else
  33.     q.rear^.next := newguy;
  34.   q.rear := newguy;
  35. end;
  36.  
  37. procedure sserve( var e : sector; var q : squeue );
  38. var
  39.   killer : nodeptr;
  40. begin
  41.   if q.front = nil then
  42.     begin
  43.       writeln('error: serve from empty squeue');
  44.       readln;
  45.       halt;
  46.     end;
  47.   killer := q.front;
  48.   with killer^ do
  49.     begin
  50.       e := s;
  51.       q.front := next;
  52.     end; {with}
  53.   if q.front = nil then
  54.     q.rear := nil;
  55.   dispose( killer );
  56. end;
  57.  
  58. procedure screate( var q : squeue );
  59. begin
  60.   q.front := nil;
  61.   q.rear := nil;
  62. end;
  63.  
  64. procedure Scan( s : sector; var m : scannerMap; var LeftOpen : integer );
  65. { visit s; mark every sector adjacent to s as examined. }
  66. var
  67.   j : warpindex;
  68. begin
  69.   m[s] := visited;
  70.   with space.sectors[s] do
  71.     for j := 1 to number do
  72.       if m[ data[j] ] = open then
  73.         begin
  74.           m[ data[j] ] := scanned;
  75.           LeftOpen := LeftOpen - 1;
  76.           write('.');
  77.         end;
  78. end; {scan}
  79.  
  80. procedure InitToOpen( var s : ScannerMap );
  81. { initialize all known or adjacent to known sectors to "open", rest to
  82. unreachable.  Warn if there are reachable unexplored sectors. }
  83. var
  84.   i : sector;
  85.   q : squeue;
  86.   j : warpindex;
  87. begin
  88.   for i := 1 to MaxSector do
  89.     s[i] := unreachable;
  90.   screate( q );
  91.   ensqueue( 1, q );
  92.   while q.front <> nil do
  93.     begin
  94.       sserve( i, q );
  95.       s[i] := open;
  96.       with space.sectors[i] do
  97.         for j := 1 to number do
  98.           if s[ data[j] ] = unreachable then
  99.             ensqueue( data[ j ], q );
  100.     end; {while}
  101.   for i := 1 to MaxSector do
  102.     if s[i] = unreachable then
  103.       writeln('Sector ', i, ' unreachable.');
  104. end; {Initialize to all open}
  105.  
  106. procedure SaveMapToDisk( var s : scannermap );
  107. var
  108.   f : text;
  109.   i : sector;
  110. begin
  111.   assign( f, GetNewFileName('File containing sector map? ',BBSName+'.map'));
  112.   rewrite( f );
  113.   for i := 1 to MaxSector do
  114.     case s[i] of
  115.       unreachable : writeln( f, i:4, ' unreachable');
  116.       visited     : writeln( f, i:4, ' visited');
  117.       scanned     : writeln( f, i:4, ' scanned');
  118.       open        : ;
  119.     end; {for case}
  120.   close( f );
  121. end;
  122.  
  123. procedure EditMap( var s : scannermap );
  124. var
  125.   dummy : integer;
  126.   i  : SectorIndex;
  127. begin
  128.   writeln('First, enter those sectors you know about (i.e. from Etherprobes)');
  129.   writeln('but where the adjacent sectors were not scanned.');
  130.   writeln;
  131.   writeln('Enter 0 to finish.');
  132.   read( i );
  133.   while i <> 0 do
  134.     begin
  135.       s[i] := scanned;
  136.       read( i );
  137.     end; {while}
  138.   writeln('Now enter those sectors that you have performed scans in.  0 to finish.');
  139.   read( i );
  140.   while i <> 0 do
  141.     begin
  142.       Scan( i, s, dummy );
  143.       read( i );
  144.     end; {while}
  145.   readln;
  146. end;
  147.  
  148. procedure InitMapFromDisk( var s : scannermap );
  149. var
  150.   f : text;
  151.   i : integer;
  152.   SVStatus : string;
  153. begin
  154.   for i := 1 to MaxSector do
  155.     s[i] := open;
  156.   assign( f, GetOldFileName( 'Name map is saved under? ', BBSName+'.map' ));
  157.   reset( f );
  158.   while not eof( f ) do
  159.     begin
  160.       i := ReadNumber( f );
  161.       readln( f, SVstatus );
  162.       if i <> 0 then
  163.         case SVStatus[1] of
  164.           'u' : s[i] := unreachable;
  165.           's' : s[i] := scanned;
  166.           'v' : s[i] := visited;
  167.         else
  168.           writeln('Line "', i, ' ', SVstatus, '" not understood.');
  169.         end; {if case}
  170.     end; {while}
  171. end;
  172.  
  173. procedure SetUpToVisit( var s : scannermap );
  174. var
  175.   i : sector;
  176.   ch: char;
  177. begin
  178.   write('Start with <F>resh map, or <R>ead in map from disk?  ');
  179.   readln( ch );
  180.   if upcase( ch ) = 'R' then
  181.     InitMapFromDisk( s )
  182.   else
  183.     InitToOpen( s );
  184.   repeat
  185.     write('<E>dit map, <S>ave map, or <C>ontinue?  ');
  186.     readln( ch );
  187.     if upcase( ch ) = 'E' then
  188.       EditMap( s )
  189.     else if upcase( ch ) = 'S' then
  190.       SaveMapToDisk( s );
  191.   until not (ch in ['e','E','s','S']);
  192. end;
  193.  
  194. function PathToThing( start : sector;
  195.                   var map : scannermap;
  196.                       which : integer ) : sectorindex;
  197. { Adjusts Distances from start up to point where "which" criteria is found;
  198.   returns sector or 0 if no appropriate sector found. }
  199. var
  200.   s : sector;
  201.   breadth : queue;
  202.   daddy, sonny : sector;
  203.   i : warpindex;
  204.   done : boolean;
  205. begin
  206.   for s := 1 to maxSector do
  207.     Distances[s].d := -1;
  208.   breadth.front := 0;
  209.   enqueue( breadth, start, start );
  210.   repeat
  211.       serve( breadth, daddy, sonny );
  212.       if Distances[ sonny ].d = -1 then {haven't hit him before:}
  213.         begin
  214.           distances[ sonny ].d := distances[ daddy ].d + 1;
  215.           distances[ sonny ].s := daddy;
  216.           with space.sectors[ sonny ] do if number > 0 then
  217.             if (space.sectors[sonny].etc and avoid) = Nothing then
  218.               for i := 1 to number do
  219.                 enqueue( breadth, sonny, data[ i ] );
  220.           case which of
  221.           1 : done := map[ sonny ] = open;
  222.           2 : done := (space.sectors[ sonny ].number = 1) and (map[sonny]=open);
  223.           end; {case}
  224.         end; {if}
  225.   until done or (breadth.front = 0);
  226.   if done then
  227.     PathToThing := sonny
  228.   else
  229.     PathToThing := 0;
  230. end; {Path to Open}
  231.  
  232.  
  233.  
  234. function NumberOpen( var m : ScannerMap ) : integer;
  235. { return the number of open sectors in array }
  236. var
  237.   count : integer;
  238.   i     : sector;
  239. begin
  240.   count := 0;
  241.   for i := 1 to MaxSector do
  242.     if m[i] = open then
  243.       count := count + 1;
  244.   NumberOpen := count;
  245. end;
  246.  
  247. procedure AddToRoute( target : sector;
  248.                   var Travels : route;
  249.                   var map : scannermap );
  250. { assumes Distances has already been properly set up.  We travel from
  251.   current position to target. If target is adjacent to the current location,
  252.   great, extend path; otherwise we have to recursively move one step
  253.   closer, and add that. }
  254. begin
  255.   if not IsWarp( travels.path[ travels.length ], target ) then
  256.     AddToRoute( distances[ target ].s, travels, map );
  257.   travels.length := travels.length + 1;
  258.   travels.path[ travels.length ] := target;
  259.   scan( target, map, travels.more );
  260. end;
  261.  
  262. procedure DoSomethingRandom(var visit : route;       { travels so far      }
  263.                             var map   : scannerMap); { map visited sectors }
  264. { Go adjacent to a random open sector }
  265. var
  266.   target : sectorindex;
  267.   skip : sectorindex;
  268. begin
  269.   skip := random( visit.more ) + 1;
  270.   target := 0;
  271.   repeat
  272.     target := target + 1;
  273.     while map[ target ] <> open do
  274.       target := target + 1;
  275.     skip := skip - 1;
  276.   until skip = 0;
  277.   writeln('random jog to ', target, ' of length ',
  278.     FixPath( visit.path[ visit.length ], target ) );
  279.   AddToRoute( distances[ target ].s, visit, map );
  280. end; {DoSomethingRandom}
  281.  
  282. procedure VisitNearestOpen(var visit : route;       { travels so far      }
  283.                            var map   : scannerMap); { map visited sectors }
  284. begin
  285.   AddToRoute( distances[ pathToThing( visit.path[visit.length], map, 1 ) ].s,
  286.               visit, map );
  287. end; {VisitNearestOpen}
  288.  
  289. procedure VisitNearestDeadEnd( var visit : route;
  290.                                var map   : scannerMap );
  291. var
  292.   s : sectorIndex;
  293. begin
  294.   s := PathToThing( visit.path[ visit.length ], map, 2);
  295.   if s = 0 then
  296.     begin
  297.       writeln('Out of dead ends');
  298.       VisitNearestOpen( visit, map );
  299.     end
  300.   else
  301.     AddToRoute( distances[s].s, visit, map );
  302. end;
  303.  
  304. procedure FindRandomRoute( var Travels : route; map : ScannerMap );
  305. { Find a route through the galaxy that visits or scans every sector in the
  306. map that isn't marked unreachable. }
  307. var
  308.   roll  : integer;
  309.   greed : integer;      { percentage of  doing something random }
  310.   ToGo  : integer;      { how many open sectors remain          }
  311. begin
  312.   write('Starting sector? ');
  313.   readln( travels.path[1] );
  314.   travels.length := 1;
  315.   Scan( travels.path[1], map, travels.more );
  316.   travels.more := NumberOpen( map );
  317.   write('Random percentage?  (0=greedy algorithm, 100=random path) ');
  318.   readln( greed );
  319.   while travels.more > 0 do
  320.     begin
  321.       roll := random( 100 );
  322.       if roll < greed then
  323.         DoSomethingRandom( travels, map )
  324.       else if roll < greed * 10 then
  325.         VisitNearestDeadEnd( travels, map )
  326.       else
  327.         VisitNearestOpen( travels, map );
  328.     end; {while}
  329. end; {FindRandomRoute}
  330.  
  331. procedure PrintTour( var t : route );
  332. {print tour to screen, and optionally to disk }
  333. var
  334.   f : text;
  335.   i : sectorindex;
  336.   filename : string;
  337. begin
  338.   writeln('path is of length ', t.length );
  339.   write('Name of file?  Hit return to display to screen: ');
  340.   readln( filename );
  341.   assign( f, filename );
  342.   rewrite( f );
  343.   for i := 1 to t.length do
  344.     begin
  345.       write( f, t.path[i] : 8 );
  346.       if i mod 8 = 0 then
  347.         writeln(f);
  348.     end; {for}
  349.   writeln( f );
  350.   if filename <> '' then
  351.     close( f );
  352. end; {PrintTour}
  353.  
  354.  
  355. procedure VisitEverySector;
  356. { Passed "SPACE" by side effect.  Goal is to find a (short) path that will be
  357. adjacent to every observed sector in the galaxy. }
  358. var
  359.   KnownGalaxy : scannerMap;
  360.   GalacticTour: route;
  361. begin
  362.   SetUpToVisit( KnownGalaxy );
  363.   FindRandomRoute( GalacticTour, KnownGalaxy );
  364.   PrintTour( GalacticTour );
  365. end; {VisitEverySector}
  366.  
  367. procedure IncPath( var home : sectorindex; sec : sector;
  368.                    var count : integer;
  369.                    var map   : ScannerMap );
  370. { add one for each open sector encountered }
  371. begin
  372.   if home <> sec then
  373.     IncPath( home, distances[ sec ].s, count, map );
  374.   if map[sec] = open then
  375.     Inc( count );
  376. end;
  377.  
  378.  
  379. procedure FindScanResults( var BaseSector     : sectorIndex;
  380.                            var EtherProbeInfo : distanceArray;
  381.                                map            : scannermap );
  382. { Load EtherProbeInfo with EtherProbeInfo.d = # open sectors on path from
  383. base point to EtherProbeInfo.s }
  384. var
  385.   i          : sector;
  386. begin
  387.   TwoWayDistances( BaseSector, distances, false, true );
  388.   for i := 1 to MaxSector do
  389.     begin
  390.       EtherProbeInfo[i].d := 0;
  391.       if distances[i].d <> maxint then
  392.         IncPath( BaseSector, i, EtherProbeInfo[i].d, map );
  393.       EtherProbeInfo[i].s := i;
  394.     end; {for}
  395. end;
  396.  
  397. procedure MarkPath( var home : sectorindex; sec : sector;
  398.                    var map   : ScannerMap );
  399. { subtract one for each open sector encountered }
  400. begin
  401.   if home <> sec then
  402.     MarkPath( home, distances[ sec ].s, map );
  403.   if map[ sec ] = open then
  404.     write( sec : 5 );
  405.   map[sec] := visited;
  406. end;
  407.  
  408. function Largest( var ER : distanceArray ) : sectorIndex;
  409. var
  410.   i : sectorIndex;
  411.   best : sectorIndex;
  412. begin
  413.   best := 1;
  414.   for i := 2 to MaxSector do
  415.     if ER[i].d > ER[Best].d then
  416.       best := i;
  417.   largest := best;
  418. end;
  419.  
  420. procedure SuggestEtherProbes{2};
  421. {Also passed "space" by side effect.  Will suggest a list of etherprobe
  422. targets that should be fired in sequence to cover as much as possible.}
  423. var
  424.   KnownGalaxy : scannerMap;
  425.   Target,
  426.   BaseSector  : sectorindex;
  427.   NewScanned  : distancearray;
  428.   i, HowMany  : integer;
  429. begin
  430.   write('How many ether probes do you want to fire? ');
  431.   readln( howmany );
  432.   SetUpToVisit( KnownGalaxy );
  433.   write('Base sector for etherprobes? (0 to abort) ');
  434.   readln( BaseSector );
  435.   if NewScanned[1].d <> -maxint then  {abort at previous step?}
  436.     for i := 1 to HowMany do
  437.       begin
  438.         FindScanResults( BaseSector, NewScanned, KnownGalaxy );
  439.         Target := Largest( NewScanned );
  440.         writeln('Target: ', target : 4, '   New sectors : ',
  441.                  NewScanned[target].d: 4);
  442.         write('Picked up: ');
  443.         MarkPath( basesector, target, KnownGalaxy );
  444.         if i mod 10 = 0 then
  445.           readln;
  446.         writeln;
  447.       end; {if}
  448. end; {SuggestEtherProbes1}
  449.